COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00011 ENDMK
C⊗;
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANR AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /INS/ INST(27),BG(60)
C	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
C   F1=86  F15=100 (NO F16!)

	COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED /SAM/ISAM
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),PCH(27,32),
	1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
	1 ,P1(27),JFM(4),COPY(30),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
	COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
	DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/2000/
	1, JFM(3)/','/
C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,IXX/'X'/
	1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	ISAM=0
	LPAR=0
	IPRN=0
	QX=0.
	MOT=0
	RETRO=-1.
	INVRT=-1
	ICON=-1
	LCNT=1
	PARENS=0
      JZ=1  
	CALL RNDINT
C  INIT RAND NUM GENERATOR.
CC    PR=0  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
	K=0
	IDALL=-1
	QTS=-1.
      KB=0  
      NWZ=1
	BNW(1)=0
	I=1
      KL=0  
      TP=0  
      RA=0  
      CHN=0 
	DO 127 K=1,77,3
127	LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
	NWX=0
	BY=-1
      DO 1128 K=1,KZY     
	INVIS(K)=0
	INST(K)=0
	CNT(K)=0
	RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
	NP(K)=0
	IQ(K)=0
C   IQ IS FOR RESTART FLAG
	IPT(K,1)=0
      DO 1128 L=1,32    
1128   PCH(K,L)=0 

	ITYP=-1
C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
	JED=-1
2112	TYPE 8002
1112	ACCEPT 77732,JNP
	JFM(4)='5F)'
	JFM(1)='   (A'
C   FOR FREE 'A' FORMAT
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,K,TF,AMPFAC,OP1,DURX
C  JFM IS THE CURRENT FORMAT STATEMENT
	IF(K.NE.'999')GO TO 999
	ISAM=-1
	TYPE 1999
	GO TO 2112
C SAMSWITCH ALLOWS FOR OVERLAPS OF INSTRUMENTS
1999	FORMAT(' "SAMSWITCH" HAS BEEN SET.')
999	IF(K.NE.'EDIT')GO TO 3112
	JED=0
	GO TO 2112
C  'E(DIT)' GOES TO EDIT MODE
3112	IF(TF.EQ.0)TF=1.
	IF(AMPFAC.EQ.0)AMPFAC=1.
21122	IF(K.NE.'TYPE')GO TO 128
	ITYP=0
	DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
	IFLNM='TYPED'
CC	IFLNM='FOR21'
CC	REWIND 21
	CALL OFILE(21,IFLNM)
	GO TO 3127
8001	FORMAT(A5,5F)
77732	FORMAT(80A1)
300	FORMAT(I,3F)
128	IF(K.EQ.'INFO')GO TO 1280
	IF(K.NE.'HELP')GO TO 3128
1280	TYPE 8002
	TYPE 1113
	TYPE 118
	TYPE 1114
	TYPE 8002
	GO TO 1112
118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22'/)
C118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC***  TEMPORARY ***8002	FORMAT(' TYPE FILE NAME'/)
8002	FORMAT(' TYPE FILE NAME--  '$)
1113	FORMAT('     NAME  TF  AMPFAC  OMIT"  DUR"'/)
1114	FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
	1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
	1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)

3128	IF(K.NE.IBLA)IFLNM=K
	CALL IFILE(23,IFLNM)
	READ(23,300)LN,IXIN
C  CHECK FOR LINE NUMBERS ONLY.
	REREAD 8001,K
	IF(K.NE.'COMME')GO TO 3000
3001	READ(23,77732)JNP
	IF(JNP(3).NE.ISEMI)GO TO 3001
	GO TO 3127
C  TO READ HEADER OF 'ET' FILES
3000	REWIND 23
	CALL IFILE(23,IFLNM)

CC3127	ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
3127	ISLAC=IFLNM
C  NOW USES MY FORNAM SUBROUTINE TO  PUT EXTENSION .SCR ON OUTPUT
5127	TYPE 118
	IF(DURX.EQ.0)DURX=19999.
	IXIN=1
	INONLY=-1
	ACCEPT 300,MX,X,Y,Z
	IF(MX.NE.99)GO TO 6127
	TYPE FINM
	ACCEPT 8001,ISLAC
	GO TO 5127
6127	IF(Z.NE.0)INONLY=Z
	IF(X.NE.0)IXIN=X
C   MX=3 GIVES DURS ONLY
C  TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
C  (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
	MZ=0
	JOUT=5
C  5=OUTPUT TO TTY
	SOS=-1.
	IF(Y.NE.0)SOS=0  
C  IF 3RD NUM=0, EDIT FILE WILL PRINT AS IT IS READ.
	IF(MX.NE.22)GO TO 2107
CC	JOUT=3
C DIRECT TO LPT AT COLGATE 6/74
	JOUT=22
	REWIND 22
2107	IF(MX.GT.1)GO TO 277
	MX=MX-2
	CALL FORNAM(ISLAC,'SCR')
277	IF(MX.EQ.-2)GO TO 77
	IF(MX.EQ.2)GO TO 77
	IF(MX.NE.22)GO TO 177
77	MZ=-1
177	IF(MX.EQ.4)MZ=-4
      CALL READIT
      END